home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / src / pl-ext.c < prev    next >
Encoding:
C/C++ Source or Header  |  1998-04-15  |  21.4 KB  |  542 lines
  1. /*  $Id: pl-ext.c,v 1.63 1998/04/15 15:16:56 jan Exp $
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: link built_in predicates
  8. */
  9.  
  10. /*#define O_DEBUG 1*/            /* include crash/0 */
  11. #include "pl-incl.h"
  12.  
  13. #if O_DEBUG
  14. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  15. See how the system reacts on segmentation faults.
  16. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  17.  
  18. static word
  19. pl_crash()
  20. { long *lp = NULL;
  21.  
  22.   Sdprintf("You asked for it ... Writing to address 0\n");
  23.  
  24.   *lp = 5;
  25.  
  26.   Sdprintf("Oops, this doesn't appear to be a protected OS\n");
  27.  
  28.   fail;
  29. }
  30. #endif
  31.  
  32. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  33. Link all foreign language predicates.  The arguments to FRG are:
  34.  
  35.     FRG(name, arity, function, flags).
  36.  
  37. Flags almost always is TRACE_ME.  Additional common flags:
  38.  
  39.     METAPRED        Predicate is module transparent
  40.     NONDETERMINISTIC    Predicate can be resatisfied
  41. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  42.  
  43. #define NDET NONDETERMINISTIC        /* make a bit shorter */
  44. #define META METAPRED        /* same */
  45.  
  46. #define FRG(n, a, f, flags) { n, f, flags, a }
  47.  
  48. static const struct foreign {
  49.   const char *  name;
  50.   Func        function;
  51.   unsigned long flags;
  52.   int        arity;
  53. } foreigns[] = {
  54. #if O_DEBUG
  55.   FRG("crash",            0, pl_crash,            TRACE_ME),
  56. #endif
  57.   FRG("nl",            0, pl_nl,            TRACE_ME),
  58.   FRG("put",            1, pl_put,            TRACE_ME),
  59.   FRG("get0",            1, pl_get0,            TRACE_ME),
  60.   FRG("get",            1, pl_get,            TRACE_ME),
  61.   FRG("skip",            1, pl_skip,            TRACE_ME),
  62.   FRG("skip",            2, pl_skip2,            TRACE_ME),
  63.   FRG("get_single_char",    1, pl_get_single_char,        TRACE_ME),
  64.   FRG("$rawtty",        1, pl_rawtty,            META),
  65.   FRG("seeing",            1, pl_seeing,            TRACE_ME),
  66.   FRG("telling",        1, pl_telling,            TRACE_ME),
  67.   FRG("seen",            0, pl_seen,            TRACE_ME),
  68.   FRG("tab",            1, pl_tab,            TRACE_ME),
  69.   FRG("tmp_file",        2, pl_tmp_file,            TRACE_ME),
  70.   FRG("delete_file",        1, pl_delete_file,        TRACE_ME),
  71.   FRG("access_file",        2, pl_access_file,        TRACE_ME),
  72.   FRG("read_link",        3, pl_read_link,        TRACE_ME),
  73.   FRG("exists_file",        1, pl_exists_file,        TRACE_ME),
  74.   FRG("exists_directory",    1, pl_exists_directory,        TRACE_ME),
  75.   FRG("rename_file",        2, pl_rename_file,        TRACE_ME),
  76.   FRG("same_file",        2, pl_same_file,        TRACE_ME),
  77.   FRG("time_file",        2, pl_time_file,        TRACE_ME),
  78.   FRG("told",            0, pl_told,            TRACE_ME),
  79.   FRG("see",            1, pl_see,            TRACE_ME),
  80.   FRG("tell",            1, pl_tell,            TRACE_ME),
  81.   FRG("append",            1, pl_append,            TRACE_ME),
  82.   FRG("ttyflush",        0, pl_ttyflush,            TRACE_ME),
  83.   FRG("flush",            0, pl_flush,            TRACE_ME),
  84.   FRG("prompt",            2, pl_prompt,            TRACE_ME),
  85.   FRG("prompt1",        1, pl_prompt1,            TRACE_ME),
  86.   FRG("expand_file_name",    2, pl_expand_file_name,        TRACE_ME),
  87.   FRG("$absolute_file_name",    2, pl_absolute_file_name,    TRACE_ME),
  88.   FRG("is_absolute_file_name",    1, pl_is_absolute_file_name,    TRACE_ME),
  89.   FRG("file_base_name",        2, pl_file_base_name,        TRACE_ME),
  90.   FRG("file_directory_name",    2, pl_file_dir_name,        TRACE_ME),
  91.   FRG("file_name_extension",    3, pl_file_name_extension,    TRACE_ME),
  92.   FRG("prolog_to_os_filename",    2, pl_prolog_to_os_filename,    TRACE_ME),
  93. #ifdef __WIN32__
  94.   FRG("win_exec",        2, pl_win_exec,            TRACE_ME),
  95. #ifdef O_XOS
  96.   FRG("make_fat_filemap",    1, pl_make_fat_filemap,        TRACE_ME),
  97. #endif
  98. #endif
  99.  
  100.   FRG("fileerrors",        2, pl_fileerrors,        TRACE_ME),
  101.   FRG("$syntaxerrors",        2, pl_syntaxerrors,        TRACE_ME),
  102.   FRG("chdir",            1, pl_chdir,            TRACE_ME),
  103.  
  104.   FRG("halt",            1, pl_halt,            TRACE_ME),
  105.   FRG("$shell",            2, pl_shell,            TRACE_ME),
  106.   FRG("getenv",            2, pl_getenv,            TRACE_ME),
  107.   FRG("setenv",            2, pl_setenv,            TRACE_ME),
  108.   FRG("unsetenv",        1, pl_unsetenv,            TRACE_ME),
  109.   FRG("wildcard_match",        2, pl_wildcard_match,        TRACE_ME),
  110.   FRG("$apropos_match",        2, pl_apropos_match,        TRACE_ME),
  111.   FRG("$argv",            1, pl_argv,            TRACE_ME),
  112.   FRG("$option",        3, pl_option,            TRACE_ME),
  113.   FRG("convert_time",        8, pl_convert_time,        TRACE_ME),
  114.   FRG("sleep",            1, pl_sleep,            TRACE_ME),
  115.   FRG("break",            0, pl_break,            TRACE_ME),
  116.   FRG("$break",            1, pl_break1,            TRACE_ME),
  117.   FRG("notrace",        1, pl_notrace1,            META),
  118. #ifdef O_LIMIT_DEPTH
  119.   FRG("$depth_limit",        3, pl_depth_limit,        TRACE_ME),
  120.   FRG("$depth_limit_true",    5, pl_depth_limit_true,       NDET|TRACE_ME),
  121.   FRG("$depth_limit_false",    4, pl_depth_limit_false,    TRACE_ME),
  122. #endif
  123.  
  124.   FRG("write_canonical",    1, pl_write_canonical,        TRACE_ME),
  125.   FRG("write_term",        2, pl_write_term,        TRACE_ME),
  126.   FRG("write_term",        3, pl_write_term3,        TRACE_ME),
  127.   FRG("write",            1, pl_write,            TRACE_ME),
  128.   FRG("writeq",            1, pl_writeq,            TRACE_ME),
  129.   FRG("print",            1, pl_print,            TRACE_ME),
  130.  
  131.   FRG("read_variables",        2, pl_read_variables,        TRACE_ME),
  132.   FRG("read_term",        2, pl_read_term,        TRACE_ME),
  133.   FRG("read_term",        3, pl_read_term3,        TRACE_ME),
  134.   FRG("read_variables",        3, pl_read_variables3,        TRACE_ME),
  135.   FRG("read",            1, pl_read,            TRACE_ME),
  136.   FRG("read_clause",        1, pl_read_clause,        TRACE_ME),
  137.   FRG("read_clause",        2, pl_read_clause2,        TRACE_ME),
  138.   FRG("$raw_read",        1, pl_raw_read,            TRACE_ME),
  139.   FRG("$raw_read",        2, pl_raw_read2,        TRACE_ME),
  140.   FRG("current_op",        3, pl_current_op,       NDET|TRACE_ME),
  141.   FRG("current_atom",        1, pl_current_atom,       NDET|TRACE_ME),
  142.   FRG("current_functor",    2, pl_current_functor,       NDET|TRACE_ME),
  143.   FRG("$complete_atom",        3, pl_complete_atom,        TRACE_ME),
  144.   FRG("$atom_completions",    2, pl_atom_completions,        TRACE_ME),
  145.   FRG("$op",            3, pl_op1,            TRACE_ME),
  146.   FRG("$reset_operators",    0, pl_reset_operators,        TRACE_ME),
  147.  
  148.   FRG("!",            0, pl_metacut,            TRACE_ME),
  149.   FRG("functor",        3, pl_functor,            TRACE_ME),
  150.   FRG("arg",            3, pl_arg,           NDET|TRACE_ME),
  151.   FRG("setarg",            3, pl_setarg,            TRACE_ME),
  152.   FRG("=..",            2, pl_univ,            TRACE_ME),
  153.   FRG("name",            2, pl_name,            TRACE_ME),
  154.   FRG("atom_chars",        2, pl_atom_chars,        TRACE_ME),
  155.   FRG("atom_char",        2, pl_atom_char,        TRACE_ME),
  156.   FRG("number_chars",        2, pl_number_chars,        TRACE_ME),
  157.   FRG("int_to_atom",        3, pl_int_to_atom,        TRACE_ME),
  158.   FRG("$format_number",        3, pl_format_number,        TRACE_ME),
  159.   FRG("atom_prefix",        2, pl_atom_prefix,        TRACE_ME),
  160.   FRG("concat",            3, pl_concat,            TRACE_ME),
  161.   FRG("$concat_atom",        2, pl_concat_atom,        TRACE_ME),
  162.   FRG("concat_atom",        3, pl_concat_atom3,        TRACE_ME),
  163.   FRG("atom_length",        2, pl_atom_length,        TRACE_ME),
  164.   FRG("$term_to_atom",        4, pl_term_to_atom,        TRACE_ME),
  165.   FRG("numbervars",        4, pl_numbervars,        TRACE_ME),
  166.   FRG("free_variables",        2, pl_free_variables,        TRACE_ME),
  167.   FRG("$e_free_variables",    2, pl_e_free_variables,        TRACE_ME),
  168.  
  169.   FRG("$open_wic",        2, pl_open_wic,            TRACE_ME),
  170.   FRG("$close_wic",        0, pl_close_wic,        TRACE_ME),
  171.   FRG("$add_directive_wic",    1, pl_add_directive_wic,    TRACE_ME),
  172.   FRG("$import_wic",        2, pl_import_wic,        TRACE_ME),
  173.  
  174.   FRG("$qlf_put_states",    0, pl_qlf_put_states,        TRACE_ME),
  175.   FRG("$qlf_start_module",    1, pl_qlf_start_module,        TRACE_ME),
  176.   FRG("$qlf_start_sub_module",    1, pl_qlf_start_sub_module,    TRACE_ME),
  177.   FRG("$qlf_start_file",    1, pl_qlf_start_file,        TRACE_ME),
  178.   FRG("$qlf_end_part",        0, pl_qlf_end_part,        TRACE_ME),
  179.   FRG("$qlf_open",        1, pl_qlf_open,            TRACE_ME),
  180.   FRG("$qlf_close",        0, pl_qlf_close,        TRACE_ME),
  181.   FRG("$qlf_load",        2, pl_qlf_load,           META|TRACE_ME),
  182.   FRG("$qlf_assert_clause",    1, pl_qlf_assert_clause,    TRACE_ME),
  183.   FRG("$qlf_info",        4, pl_qlf_info,            TRACE_ME),
  184.  
  185.   FRG("abolish",            1, pl_abolish1,           META|TRACE_ME),
  186.   FRG("abolish",            2, pl_abolish,           META|TRACE_ME),
  187.   FRG("$clause",            3, pl_clause,          NDET|META|TRACE_ME),
  188.   FRG("$clause",            4, pl_clause4,          NDET|META|TRACE_ME),
  189.   FRG("nth_clause",         3, pl_nth_clause,     NDET|META|TRACE_ME),
  190.   FRG("retract",            1, pl_retract,        NDET|META|TRACE_ME),
  191.   FRG("retractall",        1, pl_retractall,       META|TRACE_ME),
  192. #if O_DEBUGGER
  193.   FRG("$xr_member",        2, pl_xr_member,      NDET|META|TRACE_ME),
  194.   FRG("$wam_list",        1, pl_wam_list,            TRACE_ME),
  195.   FRG("$fetch_vm",        4, pl_fetch_vm,            TRACE_ME),
  196.   FRG("$clause_term_position",    3, pl_clause_term_position,    TRACE_ME),
  197.   FRG("$break_pc",        3, pl_break_pc,           NDET|TRACE_ME),
  198.   FRG("$break_at",        3, pl_break_at,            TRACE_ME),
  199.   FRG("$current_break",        2, pl_current_break,       NDET|TRACE_ME),
  200. #endif  
  201.  
  202.   FRG("flag",            3, pl_flag,            TRACE_ME),
  203.   FRG("recorda",        3, pl_recorda,            TRACE_ME),
  204.   FRG("recordz",        3, pl_recordz,            TRACE_ME),
  205.   FRG("recorded",        3, pl_recorded,           NDET|TRACE_ME),
  206.   FRG("erase",            1, pl_erase,            TRACE_ME),
  207.   FRG("assert",            1, pl_assertz,           META|TRACE_ME),
  208.   FRG("asserta",        1, pl_asserta,           META|TRACE_ME),
  209.   FRG("assertz",        1, pl_assertz,           META|TRACE_ME),
  210.   FRG("assert",            2, pl_assertz2,           META|TRACE_ME),
  211.   FRG("asserta",        2, pl_asserta2,           META|TRACE_ME),
  212.   FRG("assertz",        2, pl_assertz2,           META|TRACE_ME),
  213.   FRG("$record_clause",        3, pl_record_clause,        TRACE_ME),
  214.   FRG("redefine_system_predicate", 1, pl_redefine_system_predicate,
  215.                                META|TRACE_ME),
  216.  
  217.   FRG("$c_current_predicate",    2, pl_current_predicate,  NDET|META|TRACE_ME),
  218.   FRG("$set_predicate_attribute", 3, pl_set_predicate_attribute,META|TRACE_ME),
  219.   FRG("$get_predicate_attribute", 3, pl_get_predicate_attribute,META|TRACE_ME),
  220.   FRG("$get_clause_attribute",  3, pl_get_clause_attribute,    TRACE_ME),
  221.   FRG("$require",        1, pl_require,           META|TRACE_ME),
  222.   FRG("source_file",        2, pl_source_file,    NDET|META|TRACE_ME),
  223.   FRG("$time_source_file",    2, pl_time_source_file,       NDET|TRACE_ME),
  224.   FRG("$start_consult",        1, pl_start_consult,        TRACE_ME),
  225.   FRG("$make_system_source_files",0,pl_make_system_source_files,TRACE_ME),
  226.   FRG("$default_predicate",    2, pl_default_predicate,   META|TRACE_ME),
  227.   FRG("$clause_from_source",    3, pl_clause_from_source,    TRACE_ME),
  228.  
  229.   FRG("var",            1, pl_var,            TRACE_ME),
  230.   FRG("nonvar",            1, pl_nonvar,            TRACE_ME),
  231.   FRG("integer",        1, pl_integer,            TRACE_ME),
  232.   FRG("float",            1, pl_float,            TRACE_ME),
  233.   FRG("number",            1, pl_number,            TRACE_ME),
  234.   FRG("atom",            1, pl_atom,            TRACE_ME),
  235.   FRG("atomic",            1, pl_atomic,            TRACE_ME),
  236.   FRG("ground",            1, pl_ground,            TRACE_ME),
  237.   FRG("compound",        1, pl_compound,            TRACE_ME),
  238.  
  239.   FRG("==",            2, pl_equal,            TRACE_ME),
  240.   FRG("\\==",            2, pl_nonequal,            TRACE_ME),
  241.   FRG("=",            2, pl_unify,            TRACE_ME),
  242.   FRG("\\=",            2, pl_notunify,            TRACE_ME),
  243.   FRG("compare",        3, pl_compare,            TRACE_ME),
  244.   FRG("@<",            2, pl_lessStandard,        TRACE_ME),
  245.   FRG("@=<",            2, pl_lessEqualStandard,    TRACE_ME),
  246.   FRG("@>",            2, pl_greaterStandard,        TRACE_ME),
  247.   FRG("@>=",            2, pl_greaterEqualStandard,    TRACE_ME),
  248.   FRG("=@=",            2, pl_structural_equal,        TRACE_ME),
  249.   FRG("\\=@=",            2, pl_structural_nonequal,    TRACE_ME),
  250.  
  251.   FRG("repeat",            0, pl_repeat,           NDET|TRACE_ME),
  252.   FRG("fail",            0, pl_fail,            TRACE_ME),
  253.   FRG("true",            0, pl_true,            TRACE_ME),
  254.   FRG("$fail",            0, pl_fail,            0),
  255.   FRG("abort",            0, pl_abort,            TRACE_ME),
  256.  
  257.   FRG("statistics",        2, pl_statistics,        TRACE_ME),
  258.  
  259.   FRG("between",        3, pl_between,           NDET|TRACE_ME),
  260.   FRG("succ",            2, pl_succ,            TRACE_ME),
  261.   FRG("plus",            3, pl_plus,            TRACE_ME),
  262.   FRG("<",            2, pl_lessNumbers,        TRACE_ME),
  263.   FRG(">",            2, pl_greaterNumbers,        TRACE_ME),
  264.   FRG("=<",            2, pl_lessEqualNumbers,        TRACE_ME),
  265.   FRG(">=",            2, pl_greaterEqualNumbers,    TRACE_ME),
  266.   FRG("=\\=",            2, pl_nonEqualNumbers,        TRACE_ME),
  267.   FRG("=:=",            2, pl_equalNumbers,        TRACE_ME),
  268.   FRG("is",            2, pl_is,           META|TRACE_ME),
  269.  
  270.   FRG("trace",            0, pl_trace,            0),
  271.   FRG("notrace",        0, pl_notrace,            0),
  272.   FRG("tracing",        0, pl_tracing,            0),
  273.   FRG("debug",            0, pl_debug,            0),
  274.   FRG("nodebug",        0, pl_nodebug,            0),
  275.   FRG("$debugging",        0, pl_debugging,        0),
  276.   FRG("$spy",            1, pl_spy,           META|TRACE_ME),
  277.   FRG("$nospy",            1, pl_nospy,           META|TRACE_ME),
  278.   FRG("$leash",            2, pl_leash,             0),
  279.   FRG("$visible",        2, pl_visible,            0),
  280.   FRG("$debuglevel",        2, pl_debuglevel,        TRACE_ME),
  281.   FRG("unknown",        2, pl_unknown,           META|TRACE_ME),
  282.   FRG("$style_check",        2, pl_style_check,        TRACE_ME),
  283.  
  284. #if COUNTING
  285.   FRG("$count",            0, pl_count,            TRACE_ME),
  286. #endif /* COUNTING */
  287.  
  288.   FRG("$profile",        2, pl_profile,            TRACE_ME),
  289.   FRG("reset_profiler",        0, pl_reset_profiler,        TRACE_ME),
  290.   FRG("profile_count",        3, pl_profile_count,       META|TRACE_ME),
  291.   FRG("profile_box",        5, pl_profile_box,       META|TRACE_ME),
  292.  
  293.   FRG("prolog_current_frame",    1, pl_prolog_current_frame,    TRACE_ME),
  294.   FRG("prolog_frame_attribute",    3, pl_prolog_frame_attribute,    TRACE_ME),
  295.   FRG("$trace_continuation",    1, pl_trace_continuation,    TRACE_ME),
  296.   FRG("prolog_skip_level",    2, pl_skip_level,        0),
  297.  
  298.   FRG("$write_on_atom",        2, pl_write_on_atom,        TRACE_ME),
  299. #if O_STRING
  300.   FRG("$write_on_string",    2, pl_write_on_string,        TRACE_ME),
  301. #endif
  302.   FRG("$write_on_list",        2, pl_write_on_list,         TRACE_ME),
  303.   FRG("dwim_match",        3, pl_dwim_match,        TRACE_ME),
  304.   FRG("$dwim_predicate",    2, pl_dwim_predicate,       NDET|TRACE_ME),
  305.  
  306.   FRG("protocol",        1, pl_protocol,            TRACE_ME),
  307.   FRG("protocola",        1, pl_protocola,        TRACE_ME),
  308.   FRG("noprotocol",        0, pl_noprotocol,        TRACE_ME),
  309.   FRG("protocolling",        1, pl_protocolling,        TRACE_ME),
  310.  
  311.   FRG("$current_module",    2, pl_current_module,       NDET|TRACE_ME),
  312.   FRG("$module",        2, pl_module,            TRACE_ME),
  313.   FRG("$set_source_module",    2, pl_set_source_module,    TRACE_ME),
  314.   FRG("$term_expansion_module",    1, pl_term_expansion_module,NDET|TRACE_ME),
  315.   FRG("$declare_module",    2, pl_declare_module,        TRACE_ME),
  316.   FRG("context_module",        1, pl_context_module,       META|TRACE_ME),
  317.   FRG("$strip_module",        3, pl_strip_module,       META|TRACE_ME),
  318.   FRG("import",            1, pl_import,           META|TRACE_ME),
  319.   FRG("export",            1, pl_export,           META|TRACE_ME),
  320.   FRG("$check_export",        0, pl_check_export,       META|TRACE_ME),
  321.   FRG("export_list",        2, pl_export_list,        TRACE_ME),
  322.   FRG("index",            1, pl_index,           META|TRACE_ME),
  323.   FRG("hash",            1, pl_hash,           META|TRACE_ME),
  324. #ifdef O_HASHTERM
  325.   FRG("hash_term",        2, pl_hash_term,        TRACE_ME),
  326. #endif
  327. #if O_AIX_FOREIGN
  328.   FRG("$load_foreign",        1, pl_load_foreign1,       META|TRACE_ME),
  329. #else
  330.   FRG("$load_foreign",        5, pl_load_foreign,       META|TRACE_ME),
  331. #endif
  332.   FRG("$open_shared_object",    3, pl_open_shared_object,    TRACE_ME),
  333. #if defined(HAVE_DLOPEN) || defined(HAVE_SHL_LOAD)
  334.   FRG("close_shared_object",    1, pl_close_shared_object,    TRACE_ME),
  335.   FRG("call_shared_object_function",
  336.                 2, pl_call_shared_object_function,
  337.                                META|TRACE_ME),
  338. #endif /*HAVE_DLOPEN*/
  339.  
  340. #if O_DDE
  341.   FRG("open_dde_conversation",    3, pl_open_dde_conversation,    TRACE_ME),
  342.   FRG("close_dde_conversation",    1, pl_close_dde_conversation,    TRACE_ME),
  343.   FRG("dde_request",        4, pl_dde_request,        TRACE_ME),
  344.   FRG("dde_execute",        3, pl_dde_execute,        TRACE_ME),
  345.   FRG("dde_poke",        4, pl_dde_poke,            TRACE_ME),
  346.   FRG("$dde_register_service",    2, pl_dde_register_service,    TRACE_ME),
  347. #endif /*O_DDE*/
  348.  
  349. #ifdef O_DLL
  350.   FRG("open_dll",        2, pl_open_dll,            TRACE_ME),
  351.   FRG("close_dll",        1, pl_close_dll,        TRACE_ME),
  352.   FRG("call_dll_function",    2, pl_call_dll_function,   META|TRACE_ME),
  353. #endif /*O_DLL*/
  354.  
  355. #if O_STRING
  356.   FRG("string",            1, pl_string,            TRACE_ME),
  357.   FRG("string_concat",        3, pl_string_concat,       NDET|TRACE_ME),
  358.   FRG("string_length",        2, pl_string_length,        TRACE_ME),
  359.   FRG("string_to_atom",        2, pl_string_to_atom,        TRACE_ME),
  360.   FRG("string_to_list",        2, pl_string_to_list,        TRACE_ME),
  361.   FRG("substring",        4, pl_substring,        TRACE_ME),
  362. #endif /* O_STRING */
  363.  
  364.   FRG("is_list",        1, pl_is_list,            TRACE_ME),
  365.   FRG("proper_list",        1, pl_proper_list,        TRACE_ME),
  366.   FRG("$length",        2, pl_length,            TRACE_ME),
  367.   FRG("memberchk",        2, pl_memberchk,        TRACE_ME),
  368.   FRG("msort",            2, pl_msort,            TRACE_ME),
  369.   FRG("sort",            2, pl_sort,            TRACE_ME),
  370.   FRG("format",            2, pl_format,            TRACE_ME),
  371.   FRG("$collect_bag",        2, pl_collect_bag,        TRACE_ME),
  372.   FRG("$record_bag",        1, pl_record_bag,        TRACE_ME),
  373.   FRG("$please",        3, pl_please,            TRACE_ME),
  374.   FRG("$check_definition",    1, pl_check_definition,    META|TRACE_ME),
  375.  
  376. #if O_COMPILE_OR
  377.   FRG("$alt",            1, pl_alt,            NDET),
  378. #endif /* O_COMPILE_OR */
  379.   FRG("$atom_hashstat",        2, pl_atom_hashstat,        TRACE_ME),
  380.   FRG("$tty",            0, pl_tty,            TRACE_ME),
  381.   FRG("feature",        2, pl_feature,           NDET|TRACE_ME),
  382.   FRG("set_feature",        2, pl_set_feature,        TRACE_ME),
  383.   FRG("trim_stacks",        0, pl_trim_stacks,        TRACE_ME),
  384. #if O_SHIFT_STACKS
  385.   FRG("stack_parameter",    4, pl_stack_parameter,        TRACE_ME),
  386. #endif
  387.   FRG("$garbage_collect",    1, pl_garbage_collect,        TRACE_ME),
  388.   FRG("copy_term",        2, pl_copy_term,        TRACE_ME),
  389.   FRG("current_key",        1, pl_current_key,       NDET|TRACE_ME),
  390.   FRG("current_flag",        1, pl_current_flag,       NDET|TRACE_ME),
  391.  
  392.   FRG("open",            3, pl_open,            TRACE_ME),
  393.   FRG("open",            4, pl_open4,            TRACE_ME),
  394.   FRG("open_null_stream",    1, pl_open_null_stream,        TRACE_ME),
  395.   FRG("close",            1, pl_close,            TRACE_ME),
  396.   FRG("current_stream",        3, pl_current_stream,       NDET|TRACE_ME),
  397.   FRG("flush_output",        1, pl_flush_output,        TRACE_ME),
  398.   FRG("stream_position",    3, pl_stream_position,        TRACE_ME),
  399.   FRG("set_input",        1, pl_set_input,        TRACE_ME),
  400.   FRG("set_output",        1, pl_set_output,        TRACE_ME),
  401.   FRG("current_input",        1, pl_current_input,        TRACE_ME),
  402.   FRG("current_output",        1, pl_current_output,        TRACE_ME),
  403.   FRG("dup_stream",        2, pl_dup_stream,        TRACE_ME),
  404.   FRG("character_count",    2, pl_character_count,        TRACE_ME),
  405.   FRG("line_count",        2, pl_line_count,        TRACE_ME),
  406.   FRG("line_position",        2, pl_line_position,        TRACE_ME),
  407.   FRG("source_location",    2, pl_source_location,        TRACE_ME),
  408.   FRG("at_end_of_stream",    1, pl_at_end_of_stream1,    TRACE_ME),
  409.   FRG("at_end_of_stream",    0, pl_at_end_of_stream0,    TRACE_ME),
  410.   FRG("peek_byte",        2, pl_peek_byte2,        TRACE_ME),
  411.   FRG("peek_byte",        1, pl_peek_byte1,        TRACE_ME),
  412.  
  413.   FRG("nl",            1, pl_nl1,            TRACE_ME),
  414.   FRG("tab",            2, pl_tab2,            TRACE_ME),
  415.   FRG("put",            2, pl_put2,            TRACE_ME),
  416.   FRG("get",            2, pl_get2,            TRACE_ME),
  417.   FRG("get0",            2, pl_get02,            TRACE_ME),
  418.   FRG("read",            2, pl_read2,            TRACE_ME),
  419.   FRG("write",            2, pl_write2,            TRACE_ME),
  420.   FRG("writeq",            2, pl_writeq2,            TRACE_ME),
  421.   FRG("print",            2, pl_print2,            TRACE_ME),
  422.   FRG("write_canonical",    2, pl_write_canonical2,        TRACE_ME),
  423.   FRG("format",            3, pl_format3,            TRACE_ME),
  424.  
  425.   FRG("tty_get_capability",    3, pl_tty_get_capability,    TRACE_ME),
  426.   FRG("tty_goto",        2, pl_tty_goto,            TRACE_ME),
  427.   FRG("tty_put",        2, pl_tty_put,            TRACE_ME),
  428.   FRG("format_predicate",    2, pl_format_predicate,       META|TRACE_ME),
  429.   FRG("set_tty",        2, pl_set_tty,            TRACE_ME),
  430.   FRG("wait_for_input",        3, pl_wait_for_input,        TRACE_ME),
  431.   FRG("get_time",        1, pl_get_time,            TRACE_ME),
  432.   FRG("size_file",        2, pl_size_file,        TRACE_ME),
  433.   FRG("$default_module",    3, pl_default_module,       META|TRACE_ME),
  434. #if O_PROLOG_FUNCTIONS
  435.   FRG("$arithmetic_function",   1, pl_arithmetic_function, META|TRACE_ME),
  436.   FRG("current_arithmetic_function", 1, pl_current_arithmetic_function,
  437.                               NDET|META|TRACE_ME),
  438. #endif
  439.  
  440.   /* DO NOT ADD ENTRIES BELOW THIS ONE */
  441.   FRG((char *)NULL,        0, (Func)NULL,            0)
  442. };
  443.  
  444.  
  445. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  446. The extensions chain is used   to allow calling PL_register_extensions()
  447. *before* PL_initialise() to get foreign   extensions in embedded systems
  448. defined before the state is loaded, so executing directives in the state
  449. can use foreign extensions.
  450.  
  451. If an extension is registered before the  system extension is loaded, it
  452. will be added to the chain. Right  after the system registers the system
  453. predicates, the extensions will be registered.
  454. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  455.  
  456. struct extension_cell
  457. { PL_extension *extensions;
  458.   ExtensionCell next;
  459. };
  460.  
  461. #define ext_head        (GD->foreign._ext_head)
  462. #define ext_tail        (GD->foreign._ext_tail)
  463. #define extensions_loaded    (GD->foreign._loaded)
  464.  
  465. static void
  466. bindExtensions(PL_extension *e)
  467. { Definition def;
  468.  
  469.   for(; e->predicate_name; e++)
  470.   { short flags = TRACE_ME;
  471.  
  472.     if ( e->flags & PL_FA_NOTRACE )         flags &= ~TRACE_ME;
  473.     if ( e->flags & PL_FA_TRANSPARENT )         flags |= METAPRED;
  474.     if ( e->flags & PL_FA_NONDETERMINISTIC ) flags |= NONDETERMINISTIC;
  475.  
  476.     def = lookupProcedure(lookupFunctorDef(lookupAtom(e->predicate_name),
  477.                        e->arity), 
  478.               MODULE_user)->definition;
  479.     set(def, FOREIGN);
  480.     set(def, flags);
  481.     def->definition.function = e->function;
  482.     def->indexPattern = 0;
  483.     def->indexCardinality = 0;
  484.   }    
  485. }
  486.  
  487.  
  488. void
  489. PL_register_extensions(PL_extension *e)
  490. { if ( extensions_loaded )
  491.     bindExtensions(e);
  492.   else
  493.   { ExtensionCell cell = malloc(sizeof *cell);
  494.     cell->extensions = e;
  495.     cell->next = NULL;
  496.     if ( ext_tail )
  497.     { ext_tail->next = cell;
  498.       ext_tail = cell;
  499.     } else
  500.     { ext_head = ext_tail = cell;
  501.     }
  502.   }
  503. }
  504.  
  505.  
  506. void
  507. initBuildIns(void)
  508. { const struct foreign *f;
  509.   Definition def;
  510.   ExtensionCell ecell;
  511.  
  512.   for(f = &foreigns[0]; f->name; f++)
  513.   { functor_t fdef = lookupFunctorDef(lookupAtom(f->name), f->arity);
  514.  
  515.     def = lookupProcedure(fdef, MODULE_system)->definition;
  516.     set(def, FOREIGN|SYSTEM|LOCKED);
  517.     clear(def, TRACE_ME);
  518.     set(def, f->flags);
  519.     def->definition.function = f->function;
  520.     def->indexPattern = 0;
  521.     def->indexCardinality = 0;
  522.     if ( false(def, NONDETERMINISTIC) && 
  523.      f->arity <= 2 )
  524.       set(valueFunctor(fdef), INLINE_F);
  525.   }
  526.  
  527.   PROCEDURE_alt1         = lookupProcedure(FUNCTOR_alt1, MODULE_system);
  528.   PROCEDURE_garbage_collect0 = lookupProcedure(FUNCTOR_dgarbage_collect1,
  529.                            MODULE_system);
  530.   PROCEDURE_block3         = lookupProcedure(FUNCTOR_block3, MODULE_system);
  531.   PROCEDURE_catch3           = lookupProcedure(FUNCTOR_catch3, MODULE_system);
  532.   PROCEDURE_true0            = lookupProcedure(FUNCTOR_true0, MODULE_system);
  533.   PROCEDURE_fail0            = lookupProcedure(FUNCTOR_fail0, MODULE_system);
  534.   PROCEDURE_print_message2   = lookupProcedure(FUNCTOR_print_message2,
  535.                            MODULE_system);
  536.  
  537.   for( ecell = ext_head; ecell; ecell = ecell->next )
  538.     bindExtensions(ecell->extensions);
  539.  
  540.   extensions_loaded = TRUE;
  541. }
  542.